Checking Joe Boninger’s conjecture that for a closure of a positive braid the coefficients of (Subscript[ρ, 1]) are all positive.

SetDirectory["C:\\Users\\T15Roland\\Wiskunde\\Bn\\Heisenberg"];
Once[<<KnotTheory`; <<Rot.m];

(Subscript[R, 1])[s_,i_,j_]:=s((Subscript[g, j,i])((Subscript[g, j+1,j])+(Subscript[g, j,j+1])-(Subscript[g, i,j]))-(Subscript[g, i,i])((Subscript[g, j,j+1])-1)-1/2);
ρ[K_]:=ρ[K]=Module[{Cs,φ,n,A,s,i,j,k,Δ,G,ρ1},
{Cs,φ}=Rot[K]; n=Length[Cs];
A=IdentityMatrix[2n+1];
Cases[Cs,{s_,i_,j_}:>(A[[{i,j},{i+1,j+1}]]+=(({{-(T^s), (T^s)-1}, {0, -1}})))];
Δ=(T^((-Total[φ]-Total[Cs[[All,1]]])/2))Det[A];
G=Inverse[A];
ρ1=(∑_(k=1)^n)(Subscript[R, 1])@@Cs[[k]] - (∑_(k=1)^(2n))φ[[k]]((Subscript[g, k,k])-1/2);
Factor@{Δ,(Δ^2)ρ1/.(Subscript[g, α_,β_]):>G[[α,β]]}];

Mat[u_]:=Transpose@Table[Prepend[Table[Coefficient[((((x^(1/2))-(x^(-1/2))))^(2j))//Expand,(x^k)],{k,1,u}],(Expand[((((x^(1/2))-(x^(-1/2))))^(2j))]/.{(x^(a_Integer)):>0,x->0})],{j,0,u}]
ToConway[P_]:=If[P===0,0,Module[{CC,deg=Exponent[P,T],M},M=Inverse[Mat[deg]];
CC=Expand[P]/.{(T^(j_)):>
If[j<0,0,(T^j)]};
Total[CoefficientRules[CC,T]]/.{({a_}->b_):>b  M[[;;,a+1]].Table[(z^(2i)),{i,0,deg}]}//Expand
]]

ToConway[7+3/(T^2)+3(T^2)-101(T^4)-101/(T^4)]
%/.{z->(x^(1/2))-(x^(-1/2))}//Expand

(Subscript[Cρ, 1])[K_]:=ToConway[Expand@Together[ρ[K][[2]](-T)/(((-1+T))^2)]]
(Subscript[Cρ, 0])[K_]:=ToConway[Expand@Together[ρ[K][[1]]]]
CheckForConstantSigns[P_]:=If[Length@Union[Sign/@(MonomialList[P,z]/.z->1)]==1,True,False]
(Subscript[PosKnots, i_])[n_]:=Table[If[CheckForConstantSigns[(Subscript[Cρ, i])[K]],K,Nothing],{K,AllKnots[{3,n}]}]

(Subscript[PosKnots, 1])[10];

(Subscript[PosKnots, 0])[10];

(*False Alexander positives detected by (Subscript[ρ, 1]), i.e. knots that are not positive braid closures where the Alex is positive.*)
Complement[(Subscript[PosKnots, 0])[10],(Subscript[PosKnots, 1])[10]]

{(Subscript[Cρ, 1])[#],(Subscript[Cρ, 0])[#]}&@Knot[9,41]

(*Copied from KnotInfo*)
PosBraidKnots={Knot[3,1],Knot[5,1],Knot[7,1],Knot[8,19],Knot[9,1],Knot[10,124],Knot[10,139],Knot[10,152],Knot[11,Alternating,367],Knot[11,NonAlternating,77],Knot[12,NonAlternating,242],Knot[12,NonAlternating,472],Knot[12,NonAlternating,574],Knot[12,NonAlternating,679],Knot[12,NonAlternating,688],Knot[12,NonAlternating,725],Knot[12,NonAlternating,888]};

(*Checking Boninger's conjecture up to 12 crossings*)
CheckForConstantSigns[(Subscript[Cρ, 1])[#]]&/@PosBraidKnots

(*Values of normalized rho2 copied from the table in PG.pdf*)
ρ2819=ToConway[3T^(11)+T^(10)−2T^9+17T ^8+14T ^7−29T ^6+77T^ 5−10T^ 4+65T ^3+29T ^2−72T+239/.{T->T+(T^(-1))}]
ρ291=ToConway[4T ^(15)+T^( 14)+13T^( 13)+34T^( 11)−14T^( 10)+84T ^9−64T^ 8+194T^ 7−54T^ 6+161T^ 5+137T^ 4−52T ^3+462T^ 2−312T+702/.{T->T+(T^(-1))}]
ρ210124=ToConway[4T ^(15)+T^( 14)−3T^( 13)+21T^( 12)−12T ^(11)+42T^( 10)+13T^( 9)−61T^8+169T^ 7+11T^ 6−21T^ 5+45T ^4+278T^ 3−89T^ 2−168T+604/.{T->T+(T^(-1))}]
ρ210139=ToConway[4T ^(15)+T^( 14)−3T^( 13)+42T^( 12)−54T^( 11)+73T^( 10)+20T ^9−9T ^8−16T^ 7+328T^ 6−209T^ 5−22T^ 4+619T^ 3−306T^ 2−72T+677
/.{T->T+(T^(-1))}]
ρ210139=ToConway[4T ^(15)+T^( 14)−19T^( 13)+63T^( 12)−66T^( 11)+54T^( 10)−21T^ 9+248T^ 8−755T^ 7+1352T^ 6−960T^ 5−420T^ 4+1696T^ 3−764T^ 2−1612T+3089
/.{T->T+(T^(-1))}]